procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;


procedure CheckForSelection;
var 
  x1,y1,x2,y2,LineWidth:integer;
begin
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  GetLine(x1,y1,x2,y2,LineWidth);
  if (RoiWidth=0) or (x1>=0) then begin
    PutMessage('Please make a rectangular selection.');
    exit;
  end;
end;


procedure CropAndScale(fast:boolean; angle:real);
var
  i,OldStack,NewStack:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor:real;
  OneToOne:boolean;
begin
  CheckForStack;
  CheckForSelection;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  ScaleFactor:=GetNumber('Scale factor(0.05..25):',1.0);
  OneToOne:=ScaleFactor=1.0;
  NewWidth:=round(RoiWidth*ScaleFactor);
  if odd(NewWidth) then begin
    NewWidth:=NewWidth-1;
    ScaleFactor:=NewWidth/RoiWidth;
  end;
  SetNewSize(RoiWidth*ScaleFactor,RoiHeight*ScaleFactor);
  MakeNewStack('Stack');
  NewStack:=PicNumber;
  if not OneToOne then begin
    if fast 
      then SetScaling('Nearest; Create New Window')
      else SetScaling('Bilinear; Create New Window');
  end;
  SelectPic(OldStack);
  for i:= 1 to N do begin
    SelectSlice(1);
    if OneToOne and (angle=0.0) then Duplicate('Temp')
      else ScaleAndRotate(ScaleFactor,ScaleFactor,angle);
    SelectAll;
    Copy;
    SelectPic(NewStack);
    if i<>1 then AddSlice;
    Paste;
    SelectPic(nPics);
    Dispose; {Temp}
    SelectPic(OldStack);
    DeleteSlice;
  end;
  Dispose; {OldStack}
  RestoreState;
end;

macro 'import raw image [0]';
var
w,h:   integer;
begin
w:= GetNumber('width: ',1200);
h:= GetNumber('height: ',1000);
SetImport('Custom');
SetCustom(w,h,0);
Import('image');
end;


macro 'crop and scale - fast [1]';
begin CropAndScale(true, 0); end;

macro 'crop and scale - smooth [2]';
begin CropAndScale(false, 0); end;



macro '(-' begin end;


macro 'Median filter stack [U]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Filter('median');
  end;
end;

macro 'Sobel filter stack [O]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Filter('sobel');
  end;
end;

macro 'sharpen stack [H]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Filter('sharpen');
  end;
end;


macro 'enhance stack [C]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   EnhanceContrast;
   ApplyLUT;
  end;
end;


macro 'equalize stack [E]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   EqualizeHist;
   ApplyLUT;
  end;
end;


macro 'threshold stack [B]';
var
  i,invno,width,height,OldStack:integer;
  thresh: integer;
begin
  CheckForStack;
  thresh:= GetNumber('threshold?', 128);
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  SetThreshold(thresh);
  ApplyLUT;
  end;
end;


macro 'adaptive -mean- threshold stack [G]';
var
  i,invno,width,height,OldStack:integer;
  n,mean,mode,min,max: integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Measure;
   GetResults(n,mean,mode,min,max);
  SetThreshold(mean);
  ApplyLUT;
  end;
end;



macro 'density slice stack [D]';
var
  i,invno,width,height,OldStack:integer;
   v1,v2,v3:integer;
begin
  CheckForStack;
  v1:= GetNumber('width about 128 ?', 16);
  v2:= 128-v1;
  v3:= 128+v1;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(0,v2,255);
  end;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(v2,v3,0);
  end;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
  ChangeValues(v3,255,255);
  end;
end;


macro 'skeletonize stack [K]';
var
  i,invno,width,height,OldStack:integer;
begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;
   Skeletonize;
  end;
end;



macro 'prune stack [P]';
var
  i,j,invno,width,height,OldStack:integer;
  begin
  CheckForStack;
  for i:= 1 to nSlices do begin
   SelectSlice(i);
   SelectAll;

PruneSkeleton;
end;

  end;
end;


macro '(-' begin end;


macro 'average of stack [A]';
var
  i,invno,width,height,OldStack:integer;
begin
  AverageSlices;
end;


macro 'max of stack [Z]';
var
  i,OldStack,NewImage,TempImage:integer;
  RoiLeft,RoiTop,RoiWidth,RoiHeight:integer;
  N,NewWidth:integer;
  ScaleFactor:real;
  OneToOne:boolean;

begin
  CheckForStack;
  SaveState;
  OldStack:=PicNumber;
  N:=nSlices;
  SelectAll;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  SetNewSize(RoiWidth,RoiHeight);
  MakeNewWindow('Max');
  NewImage:=PicNumber;

  SelectPic(OldStack);
  SelectSlice(1);
	 SelectAll;
		Copy;
	 SelectPic(NewImage);
		Paste;
 
    for i:= 2 to N do begin
    SelectPic(OldStack);
    SelectSlice(i);
    Duplicate('Temp');
   TempImage:=PicNumber;
 
    ImageMath('Max',TempImage,NewImage,1.00,0,NewImage);
 
   SelectPic(TempImage);
   Dispose;
   end;
end;


macro 'max of windows into first [W]';
var
  i,invno,width,height,OldStack:integer;
   pic1,pic2,pic3,w,h:integer;
begin

SelectPic(1);
pic1:=PidNumber;
  for i:= 2 to nPics do begin
  SelectPic(i);
  pic2:=PidNumber;
  ImageMath('max',pic1,pic2,1.00,0,pic1)
  end;
end;

macro '(-' begin end;


macro 'Median filter image [M]';
var
  i,invno,width,height,OldStack:integer;
begin
   SelectAll;
   Filter('median');
end;

macro 'prune image [I]';
var
  i,j,invno,width,height,OldStack:integer;
  begin

   SelectAll;

PruneSkeleton;
end;

end;

macro 'skeletonize image [J]';
var
  i,j,invno,width,height,OldStack:integer;
  begin

Skeletonize;
end;

end;

macro 'equalize image [Q]';
begin
 EqualizeHist;
 UpdateLUT;
end;


macro 'density slice image about 128 [L]';
var
  i,invno,width,height,OldStack:integer;
   v1,v2,v3:integer;
begin
  v1:= GetNumber('width about 128 ?', 16);
  v2:= 128-v1;
  v3:= 128+v1;
   SelectAll;
  ChangeValues(0,v2,255);
  ChangeValues(v2,v3,0);
  ChangeValues(v3,255,255);
end;


macro 'thicken lines [T]';
var
  i,invno,width,height,OldStack:integer;
   pic1,pic2,pic3,w,h:integer;
begin

  SelectAll;
   Copy;
   MoveRoi(1, 0);
   Paste;
   DoOr;

  SelectAll;
   Copy;
   MoveRoi(0, 1);
   Paste;
   DoOr;

  end;
end;

macro 'smooth image [S]';
begin
Filter('Smooth');
end;

macro 'smooth image more [U]';
begin
Filter('Smooth more');
end;


macro '(-' begin end;

 

macro 'cut away rim [4]';
var
 crop,left,top,width,height:integer;
begin
	GetPicSize(width,height);
 crop:=GetNumber('width of cropped rim ?',10);
 left:=crop;
 top:=crop;
 width:=width-2*crop;
 height:=height-2*crop;
MakeRoi(left,top,width,height);
Copy;
SelectAll;
Clear;
Paste;

SelectAll;

end;


macro 'black rim for boundary map [5]';
var
 crop,left,top,width,height,xh,yh:integer;

begin

PutMessage('use for black boundaries on white background');

	GetPicSize(width,height);
 crop:=GetNumber('width of cropped rim ?',10);
 left:=crop;
 top:=crop;
xh:=crop/2;
yh:=height/2;

 width:=width-2*crop;
 height:=height-2*crop;

MakeRoi(left,top,width,height);
Copy;
SelectAll;
Clear;
Paste;
DoCopy;

AutoOutline(xh,yh);
Copy;

SelectAll;
SetForegroundcolor(255);
Fill;

Paste;
DoCopy;


end;


macro 'white rim for grain map [6]';
var
 crop,left,top,width,height,xh,yh:integer;
begin

PutMessage('use for black grains on white background');

	GetPicSize(width,height);
 crop:=GetNumber('width of cropped rim ?',10);
 left:=crop;
 top:=crop;
xh:=crop/2;
yh:=height/2;

 width:=width-2*crop;
 height:=height-2*crop;

MakeRoi(left,top,width,height);
Copy;
SelectAll;
Clear;

SetForegroundcolor(255);
Fill;

Paste;
DoCopy;

AutoOutline(xh,yh);
Copy;

SelectAll;
SetForegroundcolor(0);
Fill;

Paste;
DoCopy;

end;



macro 'smooth enlarge of outlines [8]';
var
n,mean,mode,min,max:integer;
i,j,x,y,w,h,xoff,yoff: integer;
ScaleFactor:real;
name:string;
begin
name:=WindowTitle;
ScaleFactor:=GetNumber('Scale factor:',2.0);
SelectAll;
Filter('smooth');
Copy;
GetRoi(x,y,w,h);
i:=ScaleFactor*w;
j:=ScaleFactor*h;
SetScaling('New window');
SetScaling('bilinear');
ScaleAndRotate(ScaleFactor,ScaleFactor,0.);
Filter('Smooth');
Filter('Smooth');
   Measure;
   GetResults(n,mean,mode,min,max);
  SetThreshold(mean);
  MakeBinary;
Skeletonize;
SaveAs(name,'*',Scalefactor:2);
end;
end;
end;



macro 'invert image [Y]';
begin
Invert;
end;

macro 'scale to pixel  [X]';
begin
SetScale(0,'pixel');
end;


macro 'info on histo [F]';
var
  x,y,z,w,h ,i,j,k,mode,n:integer;
  mean,mode,min,max,StdDev:real;
begin
SelectAll;
Measure;
GetResults(n,mean,mode,min,max);
PutMessage(' mean = ',mean,' mode = ',mode,' min= ', min,' max = ',max);
end;


macro 'black area percent of bitmap [$]';
var
  i,invno,width,height,OldStack:integer;
  n,mean,mode,min,max,mix: integer;
begin
   SelectAll;
   Measure;
   GetResults(n,mean,mode,min,max);
   mix:=mean/256*100;
PutMessage(' mean = ',mean,' n = ',n,' % = ', mix);
end;







